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++ 
FACILITY: FORTRAN Support Library - not user callable 
ABSTRACT: 


This module contains a routine to perform default file 
opening for FORTRAN programs. 


ENVIRONMENT: User access mode; mixture of AST level or not. 
AUTHOR: Thomas N. Hastings, CREATION DATE: 6-Mar-77; Version 0 
MODIFIED BY: 


Thomas N. Hastings, 15-Mar-77: Version 0 
Prextous edit history removed. SBL 5-Oct-1982] 
78 = Add support for DEFAULTFILE=string. JAW 30-Jun-1981 

-079 = Increase default value of RECL for unformatted variable-length 
records from 126 to 2046, to jeprove sBRt formance when 
RECORDTYPES" SEGMENTED JAW 17*Jul-1 

1-080 = Fix logic error in record type check made when user does no 
yt a record type for an old ices (Allowed both FIXED F 

SEGMENTED to be set "determining the JAW 25-Aug-1981 

1-081 = Change algorithm er determi -“e he length of a List-directed 

output record: use ee if specifi fied, else 80/81 depending on 


C 
1 
1 


carriage control. JAW reg Me 
1-082 - Add test for blocksize less — deoteia (made only if open 
or create fails and device is mag tape). If so, signal 
INCRECLEN since RMS does not give a useful message in this 
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FORSSOPEN_DEFLT FORTRAN default open 6 yh 
1-098 14-Sep-19 2:16 FORRTL FOROPENDE .832;1 (1) 


; 38 038 1! case. JAW 28-Aug-1981 

; 0 1 ! 1-083 = Save and restore the STS and STV around the SPARSE we do if we 

3; & 060 1! et an unexpected error. SBL 28-Sep-1981 

; oO 061 1! 1-006 - Signal FORSK_OPEFA] if RMS$_WLK and not readonly. DGP gr ec~1961 

ae 006¢ 1 | 1-085 = Set the MRS Tn the FAB for Indexed files. DGP 3i-Dec-1981 

; § 0065 1 ! 1-086 = Allow existing file to be SEGMENTED my if it has RFM=VAR. 

; © 0064 1! Correct 1-082 and_1-084 38 that only RMSS$_CRE errors check for 

. 0065 1! INCRECLEN, sel 13-Jan-1982 

; 66 0066 1 ! 1-087 = Complete 1-085. It was much too simplistic ong caused existing ISAM 

; of 0067 1! files to not be able to opened. DGP 22-Feb-1982 

; 668 0068 1 ! 1-088 = Unfortunately, 1-087 did not allow existing ISAM files with an MRS 

: 9 0069 1! smaller than the default buffer size to be opened unt 35s the 

; 0 0070 1! RECL was explicitly specified. Fix it. SBL 16-Apr-19 

ome s 0071 1 ! 1-089 = For devices other than disks and terminals, reduce the default 

8 0072 1! recordsize to less than the blocksize, if necessary. Use blocksize 

r £ 0075 1! as recordsize on existing files, if no MRS or LRL. SBL 30-Sep-1982 
; 7 0074 1 | 1-090 - Make default unformmated RECL 2044 instead of 2046. This allows 

ME «| 0075 1! default disk files to be copied to tape. SBL 8-Nov-198 

a 0076 1 ! 1-091 = Reflect change that OTS$$ data structures are now FOR$$. SBL 8-Nov-1982 
TR id 0077 1 ! 1-092 = Restore some INCOPECLO checks that were mistakenly deleted 
; #8 0078 1! in an earlier edit. Use new macro to call FORS$SIGNAL_STO. 

; 0079 1! Move FAB and NAM to peep at end of RAB. Add support for stream 

; 0080 1! recordtypes. Raise bucketsize Limit to 63. Use carriagecontrol 

; 81 0081 1! specified/defaulted if PPF. Don't decrement recordlength by 4 
; & 0082 1! unless SEGMENTED. SBL 29-Mar-1983 
3.60 CBS 0085 1 ! 1-093 = Add RFA cacheing for BACKSPACE. SBL 2-June-1983 

;  B4 0084 1 ! 1-094 - Restrict stream recordtypes to sequential org only. SBL 28-Jul-1983 

. 0085 1 ! 1-095 = Use LNMSC_NAMLENGTH for maximum size of equivalence string in call 

; 0086 1! to STRNLOG. DG 8-Nov-1983 é 

: 87 0087 1 ! 1-096 = Add stack location of TEMP_FNS to store the temporary filespec 
: 8688 0088 1! for ASSIGN. Also change back use of LNMS$C_NAMLENGTH to be 

; 0089 1! NAMSC_MAXRSS. LEB 2-Feb-1984 
; 0090 1 ! 1-097 - Free REY_XABs when an open fails. STAN 27-Feb-1984. 
; Wi 0091 1 ! 1-098 - DisassocTate the NAM block during the SPARSE to clear up a 
; 4 B29 ’ } problem associated with floating memory. LEB 21-Mar-1984 
; © 0094 1 
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FOR$$SIG_NO_LUB : NOVALUE, 
FORSSCB_PUSH : JSB_CB_PUSH NOVALUE, 
FORSSCB_POP : JSB_CB_POP NOVALUE, 


same as FORSSSIGNAL_STO except no LUB setup 
sO must pass LUN geri chtty, 
push current LUB/ISB/RAB, if any, and allocate LUB/ISB/RAB | 
for this logical unit , 
Pop 1/0 system back to previous LUB or indicate 
no 1/0 statement is currently being processed. 
Allocate virtual memory | 


8 

: 36 95 1! : 
H 38 1 ! PROLOGUE FILE: ; 
; 097 1! : 
: 299 098 1 : 
: 19 099 1 REQUIRE ‘RTLIN:FORPROLOG'; ! FORTRAN definitions ° 
: 101 165 1 
$ i%¢ 166 1! : 
; 10 167 1! TABLE GF CONTENTS: e 
; 104 168 1! ° 
3; 6105 169 1 ‘ 
s 106 170 1 FORWARD ROUTINE ° 
A 44 171 +1 FORSSOPEN_DEFLT : CALL_CCB NOVALUE, ' default OPEN ‘ 
; 198 1% | FORSSOPEN-PROC : CALL_CCB NOVALUE; ! common OPEN procedure ‘ 
3 110 0174 1! ‘ 
. a 0175 1 ! MACROS: ° 
3 \\§ 0176 1! e 
Sey 0177 1! NONE ° 
s 116 0178 1! ° 
3 115 0179 1 ! EQUATED SYMBOLS: ° 
; 116 0180 1! 

s 117 0181 1! NONE 

; #118 Biss 1! 

; 119 018 1 ! OWN STORAGE: 

s 120 0184 1! 

s tel 0185 1! NONE 

3 1$¢ 0186 1! 

“ee 0187 1 ! EXTERNAL REFERENCES: 

> (126 0188 #1! 

s 25 0189 1 

: 126 0190 1 EXTERNAL ROUTINE 

e Sar 0191 «#1 FORSSERR_OPECLO, OPEN/CLOSE condition handler 

: 128 O138 1 FORSSSIGRAL_STO : NOVALUE, Convert small FORTRAN err # 

: 129 0193 +1 to 32-bit VAX error # and SIGNAL_STOP 

;: 12 0194 1 

3 131 0195 1 

3 132 0196 1 

: 13 0197 1 

s 4 0198 1 

s 135 0199 1 

: «136 0200 1 

3 «137 0201 1 FORSSFREE_VM : NOVALUE, Free virtual memory 

3 138 Bebe 1 FORS$SIG_FATINT : NOVALUE, Signal_stop internal error 

; + 4 b60? ! FORSSDECC_EXITH : NOVALUE; Declaré the exit handler 

> 161 0205 1 EXTERNAL : 

3 \*¢ BSoe 1 FORSSL_XIT_LOCK; ' True if exit handler already declared 
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OBAL ROUTINE FORSSOPEN_DEFLT ( ! Default OPEN 
ACCESS VAL, 
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ee 
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TYPE_VAL i TYPE = OPENSK_ACC_{REW, 
FORM~VAL i FORM = OPENSK-FOR-{UNF, FOR, UNS) 
: CALL_CCB NOVALUE = 
ad 
ABSTRACT: 


Perform default OPEN for an I/0 statement for the indicated 
logical unit. The possible parameters are a restricted 
subset of paptiers OPEN, plus FORM = ‘UNSPECIFIED’ (for 
ENDFILE only). The aerweres for default OPEN are: 

ACCESS, TYPE, and FORM. 


! FORMAL PARAMETERS: 
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LUB_ADR.mlu.ra adr of LUB/IS8/RAB control block 
ACCESS_VAL.rlu.v Value = OPENSK_ACC_{SEQ,DIR} 
to indicate ACCESS~= "SEQUENTIAL' 
or e 
TYPE_VAL.rlu.v Value = OPENSK_TYPE {NEW, OLD} TO 
indicate TYPE = 'NEQ' or ' . 
FORM_VAL.rlu.v Value = OPENSK_FORM (UNF, FOR, UNS} 


to indicate FORM = "UNFORMATTED', 
‘FORMATTED’, or "UNSPECIFIED 
(ENDFILE only). 


IMPLICIT INPUTS: 


LUBSV_READ_ONLY 1 if "READONLY® specified in CALL FDBSET 
LUBSV"DIRECT 1 if specified on previous DEFINEFILE 
LUBS$V_OLD FILE 1 if specified on previous CALL FDBSET 
LUBS$V_UNF ORMAT 1 if specified on previous DEFINEFILE 
LUBSW_LUN FORTRAN logical unit number 

IMPLICIT OUTPUTS: 
LUBSV_DIRECi 1 if ACCESS = "DIRECT* or DEFINEFILE 
LUBSV_OLD FILE 1 if TYPE = ‘OLD’ or CALL FDBSET ‘OLD’ 
LUBSV— FORMATTED 1 if FORM = ‘FORMATTED’ 
LUBSV_UNF ORMAT 1 if FORM = ‘UNFORMATTED' or DEFINEFILE 


COMPLETION STATUS: 
NONE 

SIDE EFFECTS: 
See FORSSOPEN_PROC for SIGNAL_STOPs. 


BEGIN 


EXTERNAL REGISTER 
CCB : REF $FORSCCB_DECL; 


Be 92:32:78 EPGantL sae 


E 
Access = OPENSK_ACC_{SEQ, 


bal 


~~ 
am 


4 


SEES! he ren aaas 


-PSECT _FORSCODE.N NOWRT, SHR, PIC,2 


’ 9 
FORSSOPEN_DEFLT FORTRAN default open 16-Sep- 7:00 AX-11 Bliss-32 V4.0-74 Pa 5 FC 
1-098 14- =3ep -1 198 99: 35: :16 FORRTL.SRCJFOROPENDE .B32; 1 ~ 1: 
; o¢ 65 LOCAL 3 
: o? ? OPEN : VECTOR COPENSK_KEY_MAX + 1]; ! OPEN parameter array : 
: 205 68 16 : 
; 4 ! Clear OPEN parameter array 5 
: $08 al . 
3 09 re CHSFILL (0, (OPENSK_KEY_MAX + 1)*ZUPVAL, OPEN); : 
: 211 0274 '¢ : 
: \§ 0 oe Setup count, ACCESS, TYPE, and FORM parameter values : 
: 214 6 8 ! : 
: 215 0278 OPEN COPENSK Access) = ACCESS =VAL; : 
; 216 0279 OPEN COPENSK- TYPE] = .TYPE_V : 
; 4 9 80 OPEN COPENSK-FORM] = . FORM “VAL: : 
: 219 0989 ‘+ : 
; 220 028 i Perform the OPEN = call common procedure with a pointer ; 
: $3 BSee a to the OPEN parameter VECTOR of longword values. : 
: 3 0286 : 
3 226 028 FORSSOPEN_PROC (OPEN); : 
: 25 0288 RETURN; : 
; 226 0289 1 END; ! End of FORSOPEN_DEFLT routine : 
TITLE FORSSOPEN_DEFLT FORTRAN default open ; 
“IDENT \1-098\ : 
.EXTRN FORSSERR_OPECLO : 
-EXTRN FORSSS1GRAL _ST0 : 
.EXTRN FORSS$SIG_NO~LUB : 
-EXTRN FORSSCB Sat) Sat FORSS$CB_POP : 
~EXTRN FORSSGET. va “FORSSFREE_ VM : 
-EXTRN  FORSSSIG"F FATINT : 
003¢ 00000 ENTRY FORSSOPEN_DEFLT, Save R2.R3,R4,R5 : 0208 3 
5E 94 AE 9E 00002 MOVAB -108 : : 
006c = BF 00 6E 00 2c 90006 movcsS #0, (SP). #0, #108, OPEN : 0272 : 
10 AE 04 AC dO 90005 MOVL ACCESS VAL, OPEN+16 > 0278. : 
3C AE 08 AC DO 0001 MOVL E_VAL, OPEN+60 ; 0279 : 
14 AE OC aC 00 00018 MOVL FORMS VAL, OPEN* 20 ; 0280 | ; 
SE DD 0001D PUSHL §$ : 0287. : 
0000v CF 01 FB O0001F CALLS #1, FORSSOPEN_PROC ; : 
04 00024 RET ; 0289. : 


; Routine Size: 537 bytes, Routine Base: _FORSCODE + 0000 


; 227 0290 1 
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| FORSSOPEN_DEFLT FORTRAN default open 3 1984 00:37: AX-11 Bliss-32 V4.0-74 
1-098 a. 2 . 4 ° 1384 99:35:98 FORRTL. RCIFOROPENDE.B 2;1 (4) 


H 9 91 1 GLOBAL ROUTINE FORSSOPEN_PROC ( ' Do an OPEN . 
: it) 3 1 ! Address of OPEN parameter vector ; 
3 1 93 1 : CALL_CCB NOVALUE = ‘ 
; 9% «(1 : 
3 95 1 !4e $ 
; 7 38 : ABSTRACT: : 
: 98 1! This routine performs the OPEN for FORSOPEN and FORSSOPEN_DEFLT. : 
3 7 0299 1! The OPEN parameters have been picked up and placed in a ; 
: 8 0300 1! longword array. The index is parameter specific. The parameters ; 
; 9 0301 1! are processed in a logical order which minimizes the : 
; 240 8 oe 1} distance between parameters which depend on each other. $ 
: 241 05 1! Each parameter sets an appropriate part of the LUB/ISB/RAB 3 
: 24 0304 1! control block or the FAB control block. If the FAB $ 
s 2 0305 1! has not been allocated, it is allocated. ; 
> 244 p08 1! Whenever the FAB, RAB, LUB, or IS ; 
: 245 0307 1! are allocated they are initially set to 0. Thus, default values ; 
g soe te: : are often indicated by zero in these structures. ; 
: 348 0310 1 { FORMAL PARAMETERS: ; 
: $36 O31§ . 4 LUB_ADR.mlu.ra Adr. of LUB/ISB/RAB control block ; 
3 $2) 0313 1! OPER_ADR.mlu.ra Adr. of OPEN parameter array of ; 
; 26 0314 1! lLongwords. Index is of form: : 
; $2 0315 1! OPENSK_name. A longword value of 0 ‘ 
: 254 0316 1! indiates an omitted keyword. ‘ 
3 ge? 0317 1! ; 
3 26 0318 1 =! IMPLICIT INPUTS: ‘ 
3 gor 0319 1! : 
; 258 0320 1! LUBSV_READ_ONLY 1 if ‘READONLY’ specified in CALL FOBSET . 
; eo 0321 1! LUBSV_DIRECT 1 if specified on previous DEF INEFILE ’ 
; 260 $358 1} LUBS$V_OLD FILE 1 if specified on previous CALL FDBSET 

; 261 0323 1! LUBSV_UNF ORMAT 1 if specified on previous DEFINEFILE 

; $06 0324 1! LUBSW_LUN FORTRAN Logical unit number 

; so? O52 : LUBSW_RBUF _SIZE Size in bytes of record buffer to be allocated 

; 265 0327 1 ! IMPLICIT OUTPUTS: 

; 266 0328 1! 

: 267 0329 1! LUBSV_READ_ONLY 1 if ‘READONLY’ present or CALL FDBSET 

; 268 0330 1! LUBSV_DIRECT 1 if ACCESS = "DIRECT or DEFINEFILE 

; 269 0331 1! LUBSV_OLD_FILE 1 if TYPE = ‘OLD’ or CALL FDBSET ‘OLD’ 

3 ar Oea§ 1! LUBS$V_SCRATCH 1 if TYPE = ‘SCRATCH’ 

a ig 0333 1! L V_PRINT 1 if DISPOSE = ‘PRINT’ 

8 $i Bee 1! LUBSV_FIXED 1 if RECORDTYPE = "FIXED" : 

: 7 0335 1! LUBSV_FORMATTED 1 if FORM = ‘FORMATTED’ or ommitted 

: 274 0336 1! LUBSV_UNF ORMAT 1 if FORM = ‘UNFORMATTED' 

; 275 0337 1! or DEFINEFILE 

: $78 0358 1! LUBSA_ASSOC_VAR adr. of mn if ASSOCIATEVARIABLE = n is present 

3s a 0339 1! in OPEN or DEFINEFILE 

: $/8 0340 1! LUBSV_ASS_VAR_L 1 ifn is Longyerd 

: e279 0341 1! LUBSW_IFI RMS internal file id. Needed in case 

: 280 b308 ‘| FORTRAN CLOSE done. 

; «281 Oee 1! LUBSW_RBUF _SIZE Size in bytes of record buffer allocated. 

3 Hf 0344 1! LUB$L-LOG_RECNO 1 ‘ 

; 28 0345 1! LUBSW"R_MARGIN List girected output Line width 

: 284 0366 1! LUBS$B~ ORGAN Organization, either LUBSK_ORG_SEQUE 

; «6285 0347 1! or LUBSK_ORG_RELAT. 
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1-098 - 18-8087 138% 99:3 5 OF ia) 


74 
- 4 2:16 FORRTL.SRC JFOROPENDE .B52; 1 


: $86 25 1 i COMPLETION STATUS ; 
: 88 29 ZZ ; 
; 289 1-3 5 NONE ; 
: 290 26 1! : 
; 4 8 e7 : : SIDE EFFECTS: ‘ 
3 38 0355 1! SIGNAL _STOPs the fol Loying errors: : 
> 294 0328 1! FORS_FILNOTFOU (33 = ‘FILE NOT FOUND’) : 
3 ye 0557 3! FORS_OPEFAI (30 = ‘OPEN FAILURE’) . 
; 296 0358 1! FORS_INCRECLEN (37 = ‘INCONSISTENT RECORD LENGTH’) ; 
; 297 0359 1! FORS_INSVIRMEM (41 = ‘INSUFFICIENT VIRTUAL MEMORY) : 
; 298 0360 1! FORS_NO_SUCDEV $26 = "NO SUCH DEVICE’) : 
; 299 0361 1! FORS_FICNAMSPE (435 = ‘FILE NAME SPECIFICATION ERROR) ‘ 
; 300 8306 1} FORS_RECSPEERR (44 = ‘RECORD SPECIFICATION ERROR') | ’ 
; 01 0365 1! FORS_KEYVALERR (45 = ‘KEYWORD VALUE ERROR IN OPEN STATEMENT') ; 
; $08 0364 1! FORS_INCOPECLO (46 = ‘INCONSISTENT OPEN/CLOSE ARGUMENTS') | ; 
3 $7 Bee : FORS_INVARGFOR (47 = ‘INVALID ARGUMENT TO FORTRAN I/O LIBRARY') | : 
; 305 0367 1 ; 
; 306 0368 ; BEGIN : 
s; fur 0369 ; 
; 308 0370 2 EXTERNAL REGISTER ; 
; 309 0371 2 CCB: REF SFORSCCB_DECL; | : 
; 310 b378 r4 . 
3 2tt 0373 2 MAP : 
; 312 0374 2 OPEN_ADR : REF VECTOR COPENSK_KEY_MAX + 1); | : 
oe i. 0375 2 : 
> 314 0376 2 LOCAL ; 
gs 319 0377 2 V_DEFAULT SIZE, : 
: 316 0378 2 OPEN _STATOS, ! RMS status returned on SOPEN or SCREATE : 
; 317 0379 2 T_DFCT_FILE_NAM : VECTOR (10, BYTE), ! 10-byte default filename string ; 
; 318 0380 § ' Form: FORnnn.DAT : 
; 319 0381 ORIG_RAT: BYTE, ! Original FABSB_RAT . 
; 320 Bee § XAB_BLOCK : BLOCK CXABSC_FHCLEN, BYTE], ! allocate local FHC XAB BLOCK ; 
; 321 038 KEY" XAB : REF BLOCK COPENSK_XAB_SIZE, BYTE), ! ISAM key XAB ; 
; 322 0384 TEMP_FNS: VECTOR CNAMSC_MAXRSS, BYTE), ! Temp filespec for ASSIGN 5 : 
3 $57 tet RES_OR_EXP_NAME : VECTOR CNAMSC_MAXRSS, BYTE]; ! Storage for resultant or expanded name string : 
; $2 0387 BIND , : : 
; 6 0388 FAB = CCB: REF SFORSFAB_CCB_STRUCT, ! FAB is after RAB in CCB : 
s der 8389 NAM = CCB: REF SFORSNAM_ CCB STRUCT ! NAM is after FAB in CCB . 
; 328 390 A_LSYSSINPUT = UPLIT BYTE('SYSSINPUT:') | : 
; $3 O33) A_SYSSOUTPUT = UPLIT BYTE(*SYSSOUTPUT: *) . 
3 Zo 0398 BUILTIN ; 
: 3 Baae TESTBITSC; : 
3; 2 3 95 : 
: $e 396 LITERAL : 
: s B85 L_SYSSINPUT = ZCHARCOUNT (‘SYSS$ NPUT:*) : 
$ 36 98 L_SYSSOUTPUT = ZCHARCOUNT (‘SYSSOUTPUT:"); : 
3; 337 0399 3 
; $3 400 '¢ : 
; ) 401 ' See if ASSIGN or FDBSET has already allocated us a FAB. If so, 3 
: 9 rtf ' copy it to our local FAB and deallocate it. Copy the filename too : 
3 r4 Beoz } if it’s there. ‘ 
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PORssOPeN _DEFLT FORTRAN default open 


IF .CCB CLUBSA_FAB] NEQA 0 
THEN 


AX-11 Bliss-32 V4.0-74 
FORRTL.SRCJFOROPENDE .B52; 1 


18-Sep-1984 00: 35:9 


14-Sep-1984 


BEGIN 
LOCAL 
HEAP_FAB: REF BLOCK C. BYTE); 
HEAP FAB™= .CCB CL 
CHSMOVE (HEAP FAB ase 63 4, HEAP_FAB FAB C0, 0,0,0]); 
FORSSFREE VM (CHEAP _ FAB FABSB. “Bini. THEAP_FAB 
CCB CLUB$A FAB) = 
IF .FAB CFABSB_ FNS) NEQU 0 
THEN 
BEGIN 
CHSMOVE (.FAB rraBeet FNS]. FAB CEABSL FNAJ, TEMP_FNS); 
FORSSEREE VM ¢ FAB B FNS, .FAB CFABSL_FNAJ)? 
FAB CF SC’ FNAI 
END; 
END; 


'¢ 


i _Initialize NAM and FHC XAB_BLOCK. 


FAB CFABSL_NAM) = 0,0,0,0]; 
NAM CNAMSL"RSA] = NAN NAMSL_ -ESA] 2 
NAM CNAMSB"RSS) = wae | NAM$B-ESS) = 
SRABE NC INIT (XAB BLOCK); 

FAB CF FABSL pe 2 = HAs ABCOCK: 
KEY_XAB = RAB_B "t First 


'¢ 
: Set deferred write bit in the FAB 
relative files. 


FAB CFABSV_DFW) = 


RES_OR_EXP_NAME; 
NAMSC_MAXRSS; 


XAB in chain 


for speed improvement in 


Page 
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FORSSOPEN_DEFLT FORTRAN default open 16-Sep-1984 00:37:00 AX=-11 Biiss-32 V4.0-74 
1-098 12286871382 993 33:98 FORRTL.SRC JF OROPENDE .B52; 1 
: 380 441 : 

; 381 44 

3 §¢ 44 '¢ 

; 444 | NAME 

> «384 445 ! Setup RMS default filename string (FABSL_DNA, FABS$B_DNS) and 

; 385 46 ! file name string (FABSL_FNA) depending on the type of statement 

; 36 rr : that caused the LUN to Be opened. 

; 4 gc45 : statement file name string default file name string 

; 90 0451 ; READ FORSREAD: FORREAD.DAT 

; 91 bees : ACCEPT FORSACCEPT: FORACCEPT.DAT 

$ 4 04 : TYPE FORSTYPE: FORTYPE .DAT 

; 9 0454 : PRINT FORSPRINT: FORPRINT.DAT 

3 Be ot $2 : other FORnnn: FORnnn. DAT 

; 396 0457 ' Get pre Logtcot nit number from LUBSW_LUN instead of 

: 397 0458 ! OPENCOPENSK_UNITJ since default open doesn't set up UNIT. 

; 398 0459 ! LUN has been checked for being in legal range by CB_PUSH. 

3; a 0460 ! Set the string length and address in the FAB. 

; 400 0461 !- 

; 401 Be06 

; 40 046 BEGIN 

; 40 0464 

3 404 0465 LOCAL 

; 405 0466 A_DEF __LOGNAM, ! Address of default logical name 
; 406 0467 ; L_DEF _LOGNAM; ! Length of default logical name 
; 407 0468 

3 rts 4 98 +4 A_DEF_LOGNAM = 0; ! No default yet 

3 410 0471 CASE .CCB CLUBSW_LUN] FROM LUBSK_DLUN_MIN TO LUBSK_DLUN_MAX OF 

3 rep ger SET 

3 218 0474 CLUBSK_LUN_READ] : ! READ statement (therefore default open) 
: 416 0475 4 EGIN 

3 415 0476 4 FAB CFABSB_DNS] = ZCHARCOUNT (‘FORREAD.DAT'); 

: 416 0477 & FAB CFABSL_DNA] = UPLIT BYTE(*FORREAD.DAT'); 

3; 417 0478 & FAB CFABSB_FNS] = ZCHARCOUNT ("FORSREAD:'); 

; 418 0479 4 FAB LFABSL_F = UPLIT BYTEC'FORSREAD:'); 

> 419 0480 4 A_DEF_LOGNAM = A_SYSSINPUT; 

; 420 0481 4 L~DEFLOGNAM = L7SYSS$INPUT: 

3 $s) Bes ; ERD; 

: 4 ‘ 484 CLUBSK_LUN_ACCE) : ! ACCEPT statement (therefore default open) 
: 424 485 4 BEGIN 

: 425 0486 4 FAB CFABSB_DNS] = ZCHARCOUNT (‘FORACCEPT.DAT'); 

; 426 0487 4 FAB LFABSL_DNA] = UPLIT BYTE(*FORACCEPT.DAT'); 

: 427 488 4 FAB LFABSB_FNS) = ZCHARCOUNT (‘FORSACCEPT:'); 

; 428 489 & FAB LFABSL_FNA) = UPLIT BYTE('FORSACCEPT: ‘); 

; 4 90 4 A_DEF_LOGNAM = A_SYSSINPUT; 

, 6 491 & L_DEF_LOGNAM = L_SYSSINPUT; 

; $3) oe ; ERD; 

3 o38 rte i CLUBSE LUM TYPES ! TYPE statement (therefore default open) 
s tis rt] 4 FAB Brings = ZCHARCOUNT (‘FORTYPE.DAT'); 

: 436 97 & FAB C[FABSL_DNA) = UPLIT BYTE(*FORTYPE.DAT'); 
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IF .NAM_DSC CDSCS$W_LENGTH] GTRU 255 THEN SFORSSSIGNAL_STO (FORSK_FILNAMSPE); 


FAB CFABSB_FNS] = .NAM_DSC [DSC$W_LENGTH); 
FAB CFABSL-FNAJ = 


END 
ELSE 


+ 
! File name not specified in OPEN or this is default OPEN. 
If mame not already setup CCALL ASSIGN), use all but last 4 characters of default filename str 


! i.e., all characters but .DAT 3 
Thus filename string is a string with no punctuation so it can be a logical name 


.NAM~DSC COSCSA~POINTERI; 


494 5 FAB CFABSL_DNA] = T_DFLT_FILE_NAM; 
495 § END; 
49 
49 8 ‘+ 
498 é ' FILE 
499 8 Setup file name string to be used in RMS SOPEN 
56 
56 IF .OPEN_ADR COPENSK_NAME] NEQA 0 
56 THEN 
56 BEGIN 
6 
3¢ ' 
56 ! file name specified in OPEN 
2$ } Set length and address in FAB 
57 
57 LOCAL 
ef NAM_DSC : REF BLOCK (8, BYTE); ! File name descriptor 
3 NAM_DSC = .OPEN_ADR COPENSK_NAME); ! Get descriptor 
57 
57 
57 
58 
5 
5 
5 
5 
5 
5 


IF .FAB CFABSL_FNA) EQLA 0 
THEN 


BEGIN 
FAB CFABSB_FNS] = XCHARCOUNT ('FORnnn'); 
FAB CFABSL~FNA) = T_DFLT_FILE_NAM; 
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'¢ 
' If this is unit 5 or 6, set u 


BUF RFU AS SSVEARASLSSOVSARUNHSSRUEAR AVIS 


Lt logical 


LSSRVESRANSLS 
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. p_defau 
39 ! name to use if translation of FOROOS or FORO06 
40 0 ! fails. 
HR ‘ 
t§ 04 IF .CCB CLUBSW_LUN) EQL 5 
rf} bene THEN sats 
48 of A_DEF_LOGNAM = A_SYSSINPUT; 
4 L_DEF_LOGNAM = L_SYSSINPUT; 
48 END | 
49 6 
50 


——S0 


—Oooe 


ELSE 
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FORSSOPEN_DEFLT FORTRAN default open 16-Sep-1984 00:37:00 AX-11 Bliss-32 V4.0 
1-098 z 12-808 = 1382 99:35:98 FORRTL.SR 
; 1 1 IF .CCB CLUBSW_LUN] EQL 6 
3 ¢ £8 i THEN 
; 14 6 BEGIN 
; 554 615 6 A_DEF_LOGNAM = A_SYSSOUTPUT; 
; 5 1 L_DEF_LOGNAM = L_SYSSOUTPUT; 
; : 61 END; 
; rot 
; 8 619 4 END; 
; 9 620 4 
; 560 621 END; ! End OUTRANGE expression 
; 561 6 ; TES; 
; 66 
; 2 624 : 
; 5364 625 ! If we have an tapi Sets logical name assignment possible 
; 565 $ ' (unit<0 or unit=5 or unit=6) then attempt translation of 
> 5366 ! the logical name. If it fails, then substitute the default 
3 of 08 8 } ogical name SYSSINPUT: or SYS$OUTPUT: appropriately. 
; 569 6350 
: 570 0631 IF .A_DEF_LOGNAM NEQ 0 
; @) 06 § THEN 
3 4 0635 4 BEGIN 
3 of ste 4 
; 574 0635 4 LOCAL 
3 6ST 0636 4 LOGNAM_DSC : DSCSDESCRIPTOR, ' Logical name descriptor 
3 376 ot 2 RESULT_DSC : DSCSDESCRIPTOR; ! Translation result descriptor 
: 376 0639 4 LOGNAM_DSC [DSC$B_CLASS] = DSCSK_CLASS_S; 
; 579 0640 4 LOGNAM-DSC CDSCS$B-DTYPE] = DSCSK-DTYPE_T; 
; 580 0641 4 RESULT_DSC CDSCSB_CLASSJ = DSCS$K_CLASS_S; 
: 581 Beeg 4 RESULT_DSC CDSCSB_DTYPE] = DSCSK_DTYPE_T; 
; 28¢ 0643 4 RESULT_DSC CDSCS$W"LENGTH] = NAMSC_MAXRSS; ! Scratch string 
; 0644 4 RESULT"DSC CDSCSA_POINTER) = RES OR_EXP_NAME 
; 584 0645 4 LOGNAM-DSC [CDSCSA“POINTER] = .FAB CFABSC_FNAI; 
; 28? noee ? LOGNAM_DSC CDSCS$WILENGTH] = .FAB CFABSB_FNSJ; 
3 387 0648 4 IF .CCB CLUB$W_LUN) LSS 0 
; 588 0649 4 THEN 
3 toy 0650 4 
; 590 0651 4 '¢ : 
; 591 Bo3¢ 4 ! Don't translate trailing colon. 
; 236 0653 4 le 
; 59 0654 4 
: rh be32 2 LOGNAM_DSC CDSCS$W_LENGTH] = .LOGNAM_DSC CDSC$W_LENGTH] - 1; 
; 536 0657 4 '¢ - 
3; 39 0658 4 ' Artonst to translate the logical name putting the result in 
; 598 0659 4 ! RES_OR_EXP_NAME. We don't care what it translated to, just 
: 599 0660 4 ! the fact that it does translate. If it does not, then substitute 
; 600 0661 4 ' the default logical name for the file name. 
; 601 R006 & !e 
; 60 0665 4 
: 60 4 4 IF $STRNLOG (LOGNAM = LOGNAM_DSC, RSLBUF = RESULT_DSC) EQLU SS$_NOTRAN 
3; © 665 4 THEN 
; 605 666 5 BEGIN 
; 67 3 FAB FABSL_FNA = .A_DEF_LOGNAM; 
; 607 0668 FAB CFABSB-FNS) = .L"DEF~LOGNAM: 


; 0-74 
CJFOROPENDE .832;1 


~~ 
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RORRJOPEN.DEFLT FORTRAN detautt ope VEetecyaes QOH202 UAVS MBETo.1 P08 dP 


: $ 4 END; 

: 1 7 END; 

: 3 , END 

: 18 7% : 

3; 6146 75 + 

3; 615 28 ' Set the filename in the LUB in case an error occurs. 

: gig : a | 
; 618 67 CCB FLUBSA_RSN = .FAB CFABSL_FNA]; | 
; 619 $9 CCB CLUBSB_RSLJ = .FAB LFABSB_FNS); | 
; 620 681 ' <BLF /PAGE> | 
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FORSSOPEN_DEFLT FORTRAN default open 16-Sep-1984 7:00 AX-11 Bliss-32 V4.0-74 
1-098 " 14-Sep et 7 99: 35 :16 FORRTL.SRCJFOROPENDE .B852;1 
3s 6 ‘+ 
3; 6 1 i Do a SPARSE on the file to see if the file is a network file. If 
; 624 i SO, we will set FABSV_SQ0 and not enable RFA cacheing. Otherwise, 
; ? 5 i. we'll leave SQ0 clear~so that RFA cacheing can be allowed. 
8 ee 
; 6 3 If SPARSE TFAB = “eRe C0,0,0,03) 
: ‘ 1 BEGIN 
; 6 FAB_DEV = FAG Cop $L DEVI: BLOCK (4, BYTE); 
: O38 IF .FABZDEV CDEVSV_NET 
: 6 FAB CFABSV_SQO) = 1; 
: 6 FABSL_ STS] = ' Hide error, if an 
: B35 FAB CFABSCNAR = NAM C0,0,0:04, ' 


nN 9 
16-Sep-1984 00:37:00 - VAX=11 Bliss-32 v4.0-74 Page 1 
eR ets ake et pe ee age 35 | 


'¢ 


1 700 
64 701 ' READONLY 
64 7 § ! Set functions which may be done Subsoquens t (FABSB_FAC). 
644 7 ! If not READONLY, permit GET, PUT, TRUNCATE tvia TPT), UPDATE and DELETE. 
645 0 ! If READONLY, set LUBSV_READ_ONLY bit and use RMS default functions 
ot8 8 which can be done subsequently, namely just GETs. 
648 0 ; | 
649 8 IF .OPEN_ADR COPENSK_READONLY] 
650 THEN 
651 BEGIN 
65¢ CCB CLUBSV_READ_ONLY] = 1; 
654 ELSE 
655 
$26 if aa CFABSB_FAC] EQLU 0) 
658 FAB CFABSB_FAC] = FABSM_GET + FABSM_PUT + FABSM_TRN + FABSM_DEL + FABSM_UPD; 

0 4 


‘+ 
ACCESS 


14 
: If LUBSL_LOG_RECNO is zero, then this is not a default open of 
' a direct access file, so set the record number to 1. Otherwise, 
leave it alone because it has already been set by FORS$IO_BEG. 
if .CCB CLUBSL_LOG_RECNO] EQL 0 
CCB CLUB$L_LOG_RECNO] = 1; 
FAB CFABSV_NEF] = 1; ! inhibit EOF positioning on MT 


| 
| 
CASE. -OPEN_ADR COPENSK_ACCESS] FROM 0 TO OPENSK_ACC_KEY OF | 
| 
| 


COPENSK_ACC_DIRJ : ! ACCESS = ‘DIRECT’ 
BEGIN 


ney ! May have been set earlier 
CUBSi_LOG_RECNOJ; 
! Update on $PUT 


nnHnnni- 


CO, OPENSK_ACC_SEQ] : ! omitted cr ACCESS = "SEQUENTIAL" 
CCB fLuBsy_séa ENTIA) = 1 
CCB RAB$B-RAC) = RABSC_SEQ; 


COPENSK_ACC_APP) : ! ACCESS = ‘APPEND’ 


IF .CCB CLUBSV_READ_ONLY) 
THEN 
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FORSSOPEN_DEFLT FORTRAN default 
fons . efault open 


; 698 757 

3 44 758 

; 700 759 

; 701 760 

3 re 761 

s 70 76 

; 7046 76 

; 705 764 COPE 
ee. 765 

; 707 766 

; 708 0767 

; 709 0768 

: 710 0788 

: 711 0770 

: at 0771 

s 71 Or7e CouT 
3; 714 077 

, 7S 0774 TES; 
; 716 0775 

; uF 0776 2 !<BLF/PAGE> 
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PORSSS | GNAL STO (FORSK_INCOPECLO); 


CCB CRABSV_EOF) = 1; 

CCB [LUBSV_APPEND] = 1; 

FAB LFABSV_NEF) = 0; ! don't inhibit EOF positioning on MT 
CCB CRABSB_RAC) = RABSC_SEQ; 

END; 

NSK_ACC_KEY) : ! ACCESS = ‘KEYED’ 

BEGIN 

FAB CFAB$V_SQ0] = 0; ! May have been set earlier 
CCB CRABSB-RAC] = RABSC_KEY; 

CCB CRABSB_KRFJ = 0; 

eS LUBSV_KEYED] = 1; ! So we know Later 

RANGE] : 


SFORSSSIGNAL_STO (FORSK_INVARGFOR); 


16-56 -1984 00:37:00 AX-11 Bliss-32 V4.0-74 
1 =Sep-19 4 93733598 PORRTL SRE SFOROPENDE .B82:1 
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FORSSOPEN_DEFLT FORTRAN default open 1§- -Sep- 138¢ 9: 35:00 AX-11 Bliss-32 V4.0-74 Page 17 
1-098 14- shee 2:1 FORRTL.SRCJFOROPENDE.B32;1 (8) 
>; 719 777 ! 
; 720 ah 
s 721 77 '¢ 
3; 7 ¢ 780 ' TYPE 
: mg 
: 725 7 i CASE :OPENLADR COPENSK_TYPE] FROM 0 TO OPENSK_TYP_UNK OF 
: 726 0784 SET 
s fer Bo? 
: 728 0786 COPENSK_TYP_OLD] : ! TYPE = "OLD' 
; f 4 Bree CCB CLUBS$V OLD FILE) = 
: f 1 0789 CO, OPENSK_TYP_NEW] : ! omitted or TYPE = ‘NEW’ 
. £ ¢ 0791 IF NOT .CCB CLUBSV_OLD_FILEJ ! Could have been set by FDBSET 
3; 734 Ore THEN 
s 735 079 IF .CCB CLUBSV_READ ONLY] OR 
; 736 0794 -CCB CLUBSV_APPERD] 
s 37 0795 THEN 
; 738 0796 3 SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
; 739 0797 2 END; 
: 740 0798 
: 741 0799 COPENSK_TYP_SCR] : ! TYPE = ‘SCRATCH’ 
: 7% 0800 BEGIN 
: 74 0801 ; CCB cB fLuesy sc SCRATCH] = 
; 744 080 “TMD) = 1; 
: 745 080 ; Fe CCB B {LOsV READ Sa ih OR 
: 746 0804 LUBS$V_APPERD) 
; 7647 0805 3 THEN 
; 748 0806 3 SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
: 749 0807 2 END; 
; 750 0808 2 
s 751 0809 § COPENSK_TYP_UNK] : ! TYPE = ‘UNKNOWN' 
. ie 0810 BEGIN 
s 75 0811 3 FAB CFABSV_CIFJ = 1; 
3; 754 pete 3 IF .CCB Lossy “READ “ONLY 
.. re 081 3 THEN 
: 756 0814 3 SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
: 757 0815 2 ND; 
s 738 0816 § 
; 759 0817 COUTRANGE) : 
; 760 0818 2 SFORSS$SIGNAL_STO (FORSK_INVARGFOR); 
3; 761 0819 2 TES; 
; 76 best § 
; 76 0821 ' <BLF /PAGE> 


a7 


> 10 
ORSSOPEN_DEFLT FORTRAN default open 16-Sep-1984 00:37:00 _- VAX-11 Bliss-32 v4.0 Page 1 
-098 r hae eats rate SR hh Pd # 9 


s 765 ¢ : 
3; £ 

; 76 4 '¢ 

: 768 5 ' DISPOSE 

; 769 8 § ! Set bits in LUB to indicate DISPOSE parameters. Do not allow 

; 770 ! deletion of READONLY or SCRATCH files, printing or submitting of 

; v7 8 i SCRATCH files, or saving of SCRATCH files. 

oor 3 0 
; 776 831 SELECT .OPEN_ADR COPENSK_DISPOSE] OF 
3s 779 8 ¢ SET 

3; : 

at, ee 4 (0) : 

; ore oe 5 3 ! ommitted, do nothing 
; ree 0837 COPENSK_DIS_SAV] : ! DISPOSE = ‘SAVE’ 

3 As +44 IF .CCB CLUBSV_SCRATCH] THEN SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
: 784 0841 COPENSK DIS_DEL, OPENSK_DIS_PRDE, OPENSK_DIS_SUDE] : 
3; 785 9 bIsP OSE = ‘DELETE’, *PRINT/DELETE'. * SOBMIT/DELETE" | 
; 786 084 BEGIN 
s 767 0844 IF .CCB CLUBSV_READ_ONLY] | 
; 788 0845 THEN 

; «789 0866 ity ORSSSIGNAL_STO pone _INCOPECLO); 
; 790 084 CCB CLUBSV_DELETE) = 
; 791 0848 END; 
; 79 0849 

; 79 0850 onthe wr DIS_PRI, , OPENSK_DIS PRDE] : 

3; 794 0851 DISPOSE = ‘PRINT’; "PRINT/DELETE' 
: 795 oo 26 N 
: 796 085 

; a4 Oaee IF .CCB CLUBSV_SCRATCH] THEN SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
; «799 0856 CCB CLUBS$V_PRINT) = 1; 
; 800 0857 END; 

: 801 0858 
; 89 0859 COPENSK DIS SUB, OPENSK_DIS_SUDE] : 

: 80 0860 ! DISPOSE = ‘SUBMIT’, *SUBMIT/DELETE 

; 804 0861 BEGIN 
: 805 94) 

; 806 086 IF ee CLUBSV_SCRATCH] 

; 807 0864 

: 808 re 4 ’SFORSSSIGNAL _5TO (FORSK_INCOPECLO) 

; 809 866 ELSE 

; 810 0867 CCB CLUBS$V_SUBMIT] = 

3 ai) 0868 

; \¢ 0869 END; 

: «81 gery 

: «B14 871 COTHERWISE) : 

; 815 baa8 $FORS$SIGNAL STO (FORSK_INVARGFOR); 

: 816 087 7ES; 

; 817 0874 

; 818 0875 '<BLF /PAGE> 


~~ 
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10 
N_DEFLT FORTRAN default open 1bese -1984 00:37:00 AX-11 Bliss-32 V4.0-7 Page 19 F 
12-808- 1984 99:35:98 FORRTL.SRCJFOROPENDE. 5 2:1 . (10) | 1 
7 : : 
7 3 
7 + : 
7 | FORM 3 
$ '- : 
¢ CASE. - OPEN_ADR COPENSK_FORM] FROM OPENSK_FOR_UNS TO OPENSK_FOR_UNF OF E 
4 3 
5 COPENSK_FOR_UNS) : | ; 
§ ; ! unspecified, used by default OPEN only | : 
: CO] : ! omitted | 
30 IF -CCB CLUBSV_DIRECT] OR .CCB CLUBSV_KEYED) | : 
089 an CLUBSV_UNFORMAT) = ; 
abe CCB CLUBSV_FORMATTED) = 1; : 
0896 COPENSK FOR_FOR] : ! FORM = ‘FORMATTED'' : 
Baee CCB” CLUBSV_FORMATTED] = : 
899 COPENSK FOR_UNF J ' FORM = "UNFORMATTED' | : 
4 B™ CLUBSV “UNFORMAT] = : 
090 COUTRANGE) : ; 
090 SFORSSSIGNAL_STO (FORSK_INVARGFOR); : 
0904 TES; ; 


F 10 
FORSSOPEN_DEFLT FORTRAN default open 16-Sep-1984 00:37:00 AX-11 Bliss-32 V4.0- Page 20 f 
1-098 . 18-808- 1382 993 35:98 FORRTL.SRC F OROPENDE . 5 2:1 ° 195 1 
; 28 7 ! ' 
$ 908 ; 
; 854 909 + ; 
; 855 910 ' RECORDTYPE 3 
Be me : 
; 858 091 CASE_.OPEN_ADR COPENSK_RECORDTY] FROM 0 TO OPENSK_REC_STMLF OF : 
; 859 0914 SET : 
; 860 0915 : 
; 861 3918 (0) : ! omitted : 
P 86 091 ° 
; 8 0918 + : 
; 864 0919 ! Do nothing right now. We have insufficient information ; 
; 865 0920 i to determine the recordtype. Wait until the organization : 
; 866 0921 i has been determined. | ‘ 
; 867 09 ¢ ie ‘ 
; 868 09 2 ; 
; 869 0924 ; ‘ 
; 870 0925 ; 
; 871 0926 COPENSK_REC_FIX] : ' RECORDTYPE = ‘FIXED' ‘ 
3 87 pose BEGIN | 
s 87 0928 eco AB EFABSOTRIM FI xgo DJ) = 1; : 
; 874 09¢9 = FABSC_FIX; : 
3 879 0930 2 g : 
; 876 0931 2 3 
; fa4 O33¢ COPENSK_REC_VAR] : ! RECORDTYPE = ‘VARIABLE’ ‘ 
; 879 0934 FAB CFABSB_RFM] = FABSC_VAR; : 
; 880 0935 2 END; : 
; 881 0936 2 : 
; 882 0937 ¢ COPENSK_REC_SEGM) : ! RECORDTYPE = ‘SEGMENTED’ ; 
3 tt p3a8 ; BEGIN . 
3 rH Bee ; IF .CCB CLUBSV_DIRECT] OR .CCB CLUBS$V_KEYED] OR .CCB CLUBSV_FORMATTED] ; 
; rt Bee ; SFORSSSIGNAL_STO (FORSK_INCOPECLO); : 
; 889 0944 3 FAB CFABSB_RFM) = FABSC = il 3 
: 890 0945 3 cc LUBSV_SEGMENTED) = 3 
; 891 094 § END; : 
; «489 0947 : 
; 89 0948 COPENSK_REC_STM) : ' RECORDTYPE = ‘STREAM’ ‘ 
: 894 0949 N i 
; 895 0950 FAB CFABSB_RFM) = FABSC_STM; 3 
; 896 0951 2 END; } 
; 897 0326 2 ; 
; 898 095 COPENSK_REC_STMCR] : ! RECORDTYPE = ‘STREAM_CR‘ : 
; 899 0954 BEG i 
; 900 0955 FAB CFABSB_RFM) = FABSC_STMCR; : 
: 901 0956 END; ; 
; 90 pee 3 
; © 958 COPENSK_REC_STMLF]) : ! RECORDTYPE = ‘STREAM_LF’ 
: 904 0959 GIN 
; 905 0960 FAB CFABSB_RFM] = FABSC_STMLF; 
: 906 0961 END; 
; 907 8494 
: 908 096 COUTRANGE) : 


foyer seret verte avtets coe ee oe ee 


: 310 ¢ ; =. (FORSK_INVARGFOR) ; 
> 1 . 
367 3 1 <BLF/PAGED 


: 912 


F N_DEFLT FORTRAN def 
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93 


96 
9 


: 
: 
: 
: 


1-0-1984 99:32:09 


'¢ 
CARRIAGE CONTROL 
= ee COPENSK_CARRIAGE] FROM 0 TO OPENSK_CAR_NON OF 
(0) : ! omitted 
IF .CCB CLUBSV_FORMATTED] THEN FAB CFABSV_FTN] = 1; 
CoPewes. AR_FOR] : ! CARRIAGECONTROL 
FABSV_ FIN] = 1; 
alee CT" LIS] : !' CARRIAGECONTROL 
FAB CFAB$V_CR) = 1; 
COPENSK_CAR_NON) : 
3 ! CARRIAGECONTROL 
COUTRANGE) : 


$; $FORSSS1GNAL _5TO (FORSK_INVARGFOR); 


'¢ 

i Store 

a opene 

ORIG_RA 
' <BLF /PAGE> 


FABSB_RAT so we can “‘restore’’ it if we find we've 
d @ process-permanent file. 


T = .FAB CFABSB_RATI; 


AX-11 BLi iege3 32 V 
PORRTLS SRCJF dkore 


= ‘FORTRAN’ 


= "LIST’ 


= "NONE', do nothing 


ADE B82; 1 


ne 
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| FORSSOPEN_DEFLT FORTRAN default open 1-Se 1984 00:37:00 AX-11 Bliss-32 V4.0-74 Page 23 
| 1-096 14-Sep-19 4 $95 33:9 LFORRTL SRE FOROPENDE .852;1 . 183 

949 8 ; 

950 

32) ‘+ 

9 ¢ 5 ! ORGANIZATION 

3c 09 a 

$85 a8 CCB CLUBSV_NOTSEQORG) = 1; ! Assume not sequential organization 

$57 Te COPENSK_ORGANIZA] FROM 0 TO OPENSK_ORG_IDX OF 

959 

960 CO, OPENSK_ORG_SEQ) : ! omitted or ORGANIZATION = ; SEQUENTIAL’ 

+d BEGIN 

368 IF .CCB CLUBSV_DIRECT] AND .FAB CFABSB_RFM] EQLU FABSC_VAR THEN SFORSSSIGNAL_STO (FORSK_INCOPECL | 

967 IF .CCB CLUBSV_KEYED] AND .OPEN_ADR COPENSK_ORGANIZA] NEQ 0 

34 SFORSSSIGNAL_STO (FORSK_INCOPECLO); 

971 FAB C[FABSB_ORG) = FABSC_ SEQ; 

97 = 0; ! So ENDFILE will know its sequential 


ece LUBSV_NOTSEQORG 


COPENSK_ORG_REL) : ! ORGANIZATION = ‘RELATIVE’ 
BEGIN 


If .CCB CLUBSV_SEGMENTED] OR .CCB CLUBSV_KEYED] THEN SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
FAB CFABSB_ORG) = FABSC_REL; 
END; 


ee ee ee ee ee eee SS 
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COPENSK_ORG_IDX] : ' ORGANIZATION = ‘INDEXED’ 
9 BEGIN 
.) IF .CCB CLUBSV_DIRECT] OR .CCB CLUBSV_APPEND] OR .CCB CLUBSV_SEGMENTED] 
one SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
990 FAB CFABSB_ORG) = FABSC_IDX; 
991 END; 
gy 
99 COUTRANGE) : 
994 SFORSSSIGNAL_STO (FORSK_INVARGFOR); 
995 TES; 
397 4 
p44 Verify that user didn't ask for a non-sequential stream file. 
1000 ; 
1001 IF .CCB CLUBSV mpT seoons) AND 
1008 ONE_OF (.FAB CFABSB_RFM), FABSC_STM, FABSC_STMCR, FABSC_STMLF) 
Hs SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
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14-Sep-1984 2:16 FORRTL. FOROPENDE .B52; 1 


14 
' RECORDTYPE continued 


' We now have —- information to determine the initial recordtype 
if it was omitted. 


IF .OPEN_ADR COPENSK_RECORDTY] EQ. 0 
THEN 


IF .FAB CFABSB 
LUBSV_RE 


BEGIN 
FAB fFABsB_REM] = FABSC_FIX; 
CCB CLUBSVZFIXED) = 1; 


BEGIN 
FAB CFABSB_RFM] = FABSC_VAR; 
IF .CCB CLUBSV_UNFORMAT) THEN CCB CLUBSV_SEGMENTED] = 1; 
END; 

+ 


SHARED 
If SHARED, indicate user provided record interlock (UPI) (for SEQUENTIAL ORG only) 
If mot SHARED, RMS defaults is read, sharing only if READONLY, else no sharing. 


' 
i 
i 
i 
le 
IF .OPEN_ADR COPENSK_SHARED] 
THEN 
BEGIN 


FAB CFABSB_SHR] = FABSM_SHRGET + FABSM_SHRPUT + FABSM_SHRUPD + FABSM_SHRDEL; 
i aor -CCB CLUBSV_NOTSEQORG] !' Sequential only, set UPI 
FAB CFABS$V_UPI) = 1; 
END; 
' <BLF /PAGE> 


| 
pre? fet FABSC_REL OR .FAB CFABSB_ORG] EQL FABSC_IDX OR .CCB CLUBS$V_DIRECT] OR .CCB EC) 


&$ 


K 10 
SSOPEN_DEFLT FORTRAN default open 16-Se 
8 14-Se 


-1984 99:32:00 AX-11 OL isges2 V4.0-7 
-1984 12:32:16 


2: FORRTL.SRC JF OROPENDE 


Total number of ke $ defined 
Address of newly allocated KEY XAB 


Wg gg 

$ 1981 11 ‘ '¢ 

5 1 ¢ 1104 ' KEY 

3 3 1105 Hd 

; 1054 1198 

; 1055 11 If .OPEN_ADR COPENSK_KEY] NEQU 0 

; 1928 1108 H 

; 10 1109 BEGIN 

; 1058 1110 

; 1059 1111 OCAL 

; 1060 ig KEY_DEFN : REF BLOCK (12, BYTE], ' Key definition 
; 1061 111 KEY_NUM, ! Number of current ke 
; 106¢ 1114 KEY-COUNT, ' 

; \SS7 4132 XAB_ADDR; : 

; 1908 ni? IF .FAB CFABSB_ORG] NEQU FABSC_IDX THEN SFORSSSIGNAL_STO (FORSK_INCOPECLO); 
; 1067 1119 KEY_DEFN = .OPEN_ADR COPENSK KEY]; 

: 1068 1120 KEY-COUNT = .KEY-DEFN COPENSQ_INFO); 

; 1988 i 1 KEY_DEFN = .KEY_BEFN + ZUPVAL; 

: 197) 5 IF .KEY_COUNT MOD 3 NEQ 0 THEN SFORSSSIGNAL_STO (FORSK_INVARGFOR); 
; 1078 1125 KEY_COUNT = .KEY_COUNT/3; 

: 1074 1126 

: 1075 Vist + 

$ 1978 1% 3 Loop through key definitions, and set up the key XABs. 
: 1078 1130 

; 1079 1131 INCR KEY_NUM FROM 0 TO .KEY_COUNT - 1 DO 

: 1080 11 ; 4 BEGIN 

; 1081 1133 4 XAB_ADDR = FORSSGET_VM (OPENSK_XAB_SIZE); 

3 1OSs 1134 4 KEY_XAB CXABSL_NXTJ™= .XAB_ADOR; 

3 108 1135 4 KEY_XAB = .XAB_ADDR; 

> 1084 1136 4 

: 1085 1137 4 '+ 

3 1288 1138 4 ! Fill im KEY XAB fields 

: 108 1139 4 t= 

: 1088 1140 4 

3 1089 1141 4 CHSFILL (0, OPENSK_XAB SIZE, .KEY_XAB); 

: 1090 1166 4 KEY_XAB Prete = RABSC_KEY; 

; 1091 1143 4 KEY_XAB CXAB$B_-BLN) = XABSC_KEYLEN; 

3 1998 1144 4 

3; 109 1145 4 i} 

; 1094 1168 4 ' Calculate key position and width 

; 1095 1147 4 le 

3 1996 1148 4 

31 1149 4 IF .KEY_DEFN COPENSL_KEY_LO) LEQ OR 

; 1098 1150 4 -KEY-DEFN COPENSL-KEY_-LO) GTR 32767 OR 

3; 1099 1151 4 -KEY_DEFN COPENSL_KEY_HIJ GTR 32767 OR 

: Y's 1136 ? -KEY_DEFN COPENSL_KEY_HI) LSS .KEY_DEFN COPENSL_KEY_LO) 
; 1136 1138 2 SFORSSSIGNAL_STO (FORSK_INVKEYSPE); 

3 1104 1196 4 KEY_XAB [XABS$W_POSO] = .KEY_DEFN COPENSL_KEY_LO) - 1; 
3; 1105 1157 4 KEY_XAB ([XAB$B_S1Z0) = 


4 
-B32;1 


Page 25 
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FORSSOPEN_DEFLT FORTRAN default open 18-Sep-1986 00:37:00 -VAX=11 BLiss-32 vé.0-7 : | 
1-098 ’ aeons rit oe a a hg pd age 426 
BEGIN 
LOCAL 
SIZE; 


SIZE = .KEY_DEFN COPENSL_KEY_HI] = .KEY_DEFN COPENSL_KEY_LOJ + 1; | 
IF .SIZE GTR 255 THEN SFORSSSIGNAL_STO (FORSK_INVKEYSPE); 


SIZE 
ND; 
KEY_XAB OPENS $u_posd] = -KEY_XAB [XABSW_POS 1: 
KEY~ =XAB -KEY-XAB CXAB$B~SIZ 
KEY~ _DEFN OPENSB. DTYPE] OF 


XABSS a OTP 2 (SELECTONE KEY 


ster DTYPE 1] : sxansc caste 
DTYPE_W i 

DTYPE-W] : xAgse “WN Ne; 
-pIYPE-y J: .REY XAB_CXAB$B_SIZ0] EQL 4 THEN XABSC_BN4 ELSE XABSC_BN2; 
Ise? : if .KEY_RAB CXABSB_ $7 0] EQL 4 THEN XABSC_ING ELSE XABSC_IN2; 


E 


SFORSSS1GNAL_ STO (FORSK_INVARGFOR) ; 


TES) 

KEY_XAB en = .KEY_XAB CXAB$B_DTP); 
IF .KEY_NUM NEQ 0 

THEN 


BEGIN 
KEY_XAB CXABSV_CHG] 
ERDT =XAB CXAB$V_DUP] 


“uu 
—— 
Sete 


KEY_XAB CXABS$B REF) = 
Ker DEFN = .KEY_DEFN + 4 *ZUPVAL); ! Go to next definition 


END; 


'¢ 

! BLANK 
‘ If user specifies BLANK="NULL* then set LUBSV_NULLBLNK 
else leave it alone. 


CASE. -OPEN_ADR COPENSK_BLANK] FROM 0 TO OPENSK_BLK_NUL OF 


CO, OPENSK_BLK_ZER) : ; : 
3 ! Do nothing, ZERO is the default 


COPENSK LK_NUL 
B-PtuBSyeN NULLBLNK} = 


COUTRANGE) : 
$F ORS$SIGNAL -5TO (FORSK_INVARGFOR) ; 
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FORSSOPEN_DEFLT FORTRAN default open Page 28. 
1-09 ' Rist 


RECORDSIZE 
Set maximum record size (FABSW_MRS) if fixed, relative, or indexed. 
Set V_DEFAULT_SIZE if omitted. Set LUBS$W ~_— SIZE to record size. 
Defaulf is 128°for unformatted fixed Length, 2024 for unformatted 
vor teeie Length (4 bytes for RMS control info to make total 2048) 
for formatted (Line printer width) or unspecified (ENDF ILE 
default OPEN). 


V_DEFAULT_SIZE = 0; ! assume user specifies 
SELECTONEU .OPEN_ADR COPENSK_RECORDSI] OF 


(0) : 


MEW OO CONOUS WR -"OOOa~s 


i If this is a fixed length or relative file, and 
! is not known to exist, RECORDSIZE must be given, else 
! error FORS_INCRECLEN. 


x7 
Mm 


IF aa CLUBSW_RBUF _SIZEJ EQLU 0 
BEGIN 


IF NOT .CCB CLUBSV_OLD_FILE] AND (.CCB CLUBSV_FIXED] 
OR .FAB CFABS$B_ORG) EQL FABSC_REL) 


SFORSSSIGNAL_STO (FORSK_INCRECLEN) ; 
CCB CLUBSW_RBUF SIZE] = ( 


BEREAN PU NINNINUNINUN) — 


ooo CODWMDODmMDMmoaT~~ ANO 


If cs CLUB$SV_UNFORMAT) ! unformatted 
IF .CCB CLUBSV_FIXED] 
THEN 38 ' fixed | 
MH xe 
20 ELSE ; 
2044 : variable pm 
ELSE es) ! formatted or unspecified (ENDFILE default open) 
V DEFAULT _SIZE =1; ' user took the default 


{1 TO 32767) : 
BEGIN 


LOCAL 
T: 


NS et et et et oo tt OO 
SOOONC UE w Oo SO@~ 
SAA AAA AAA AA MMA 


T = ,OPEN_ADR COPENSK RECORDSIJ*(IF .CCB CLUBSV_UNFORMAT] THEN ZUPVAL ELSE 1) : 
+ (IF .CCB CLUBSV_SEGMENTED] THEN 2 ELSE 0); 


IF .1 GTRU 32767 THEN SFORSSSIGNAL_STO (FORSK_INCRECLEN); 
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14 
' INITIALSIZE . , 
Only set if specified in explicit OPEN, since may be set by FDBSET on default OPEN. 


IF .OPEN_ADR COPENSK_INITIALS] NEQ 0 
THEN 


BEGIN 
FAB CFABSL_ALQ] = ABS (.OPEN ADR COPENSK.INITIALSI); 
FAB CFABSV_CBT] = 1; 


'¢ 
! EXTENDSIZE : / : ‘oe 
Only set if specified explicitly in explicit OPEN, since FDBSET could set on default open. 


rrr 
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IF .OPEN_ADR COPENSK_EXTENDSI] NEQU 0 
THEN 


IF ABS (.OPEN_ADR COPENSK_EXTENDSIJ) LSSU 1°16 
ese’ CFABSV:_DEQ] = ABS (.OPEN_ADR COPENSK_EXTENDSIJ) 
SFORSSSIGNAL_STO (FORSK_KEYVALERR); | 


— Se oO =] owowo Ooo 
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'¢ 


NOSPANBLOCKS 


FAB CFABSV_BLK] = .OPEN_ADR COPENSK_NOSPANBL]; 


'+ 
! MAXREC 

: otf set if explicitly passed by OPEN statement, since 
DEFINE FILE couid have pre-set it if this is default open. 


mnNn-—— polelolejajlejleolelola} sie) s) ooo 


a 
IF .OPEN_ADR COPENSK_MAXREC] NEQU 0 THEN CCB CLUBSL_REC_MAX] = .OPEN_ADR COPENSK_MAXREC); | 


FAB CFABSL_MRN] = .CCB CLUBSL_REC_MAX]; | 
! <BLF /PAGE> 
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01 
+ al tet FORTRAN default open 19-3 


aah 90:32:00 AX-11 Bliss-32 V4.0-74 
p-1984 12:32:16 FORRTL.SRCJFOROPENDE .B52;1 


31 1333 : 

; 3 Rs 1334 

3; 3 1335 ‘+ 

3 3 1 $ i BLOCKSIZE 

3 1 1 i Set BLOCKSIZE (used for Bogtase pe ,nutet=otock count (sequential org only) 
: 1289 1338 i and bucket size (relative/indexed onl 

: 1290 1339 t= 

: 1291 1340 

3 3 4 1341 SELECTONEU .OPEN_ADR COPENSK_BLOCKSIZ) OF 

: 129 1 rk: SET 

: 1294 134 

: 1295 1344 C0] 

3 1296 1345 : ! Use process/system defaults 
3; 1297 1 #6 

3: 1298 134 {1 TO 65535) : 

3: 1299 1348 BEGIN 

; 1500 1349 FAB CFABSW_BLS) = .OPEN_ADR COPENSK BLOCKSIZ); 

3; 1301 1350 CCB LRABSB “mee = (, 20nee ae OPENSR_BLOCKS $17) + 511)/512; 
3 3 Og 1351 FAB CFAB$B°B CCB CRABSB_MBCI; 

; 130 1 3 IF .FAB CFABSe “BKS) GTRU 63 !"RMS Limit 

: 1304 135 THEN 

3 1305 1354 FAB CFAB$B_BKS) = 63; 

3: 1306 132? END; 

: 1307 1356 

: 1308 1357 COTHERWISE) : 

31 09 1358 SFORSSSIGNAL_STO (FORSK_KEYVALERR); 

3; 1310 1359 3 

3 1311 1360 2 

3; 1312 1361 2 !<BLF/PAGE> 
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FORSSOPEN_DEFLT FORTRAN default cpen 16-5 $ep-1984 AX-11 Bliss-32 V4.0-7 Page 32 f 
et a 7 ss =30 0-1 Re 99: $5 90 FORRTL. aR C FOROPENDE. 8 2;1 . RT sd 1 
; 1314 136 : ‘ 
; 1315 136 ‘ 
| 18 1364 + ; 
3 13) 1365 ' BUF FERCOUNT : 
3 1 18 136 ' Only set if expli igtthy passed by OPEN statement since FDBSET could ‘ 
3: 151 136 : _have pre-set “it if this is a default open. ° 
: 1354 1369 
3 § 1 19 SELECTONEU .OPEN_ADR COPENSK_BUFFERCO) OF : 
3 3 137 SET : 
> 1324 137 | : 
4 1326 1374 4 | ° 
3 1 sf 1375 3 
; 1328 137 {1 TO 127) : 3 
H } ; : As ccB CRABSB _MBFJ] = .OPEN_ADR COPENSK_BUFFERCO); ; 
; 1331 1379 COTHERWISE) : H 
31 é 1380 SFORSSSIGNAL_STO (FORSK_KEYVALERR); | ; 
: 133 1381 ES; 3 
3 1334 1386 : 
3 1332 138 '¢ 3 
3; 1336 1384 ' ASSOCIATEVARIABLE : 
3; 1337 1385 !- | 3 
; 1338 1386 : 
3; 1339 1387 IF .OPEN_ADR COPENSK_ASSOCIAT] NEQA 0 : 
; 1340 1388 THEN 3 
3 1341 1389 BEGIN 3 
3 ok 1330 CCB CLUBSA_ASSOC_VAR] = .OPEN_ADR COPENSK_ASSOCIAT); : 
3 1344 1392 IF .OPEN_ADR COPENSK_ASSOC_LJ THEN CCB CLUBSV_ASS_VAR_L] = : 
3; 1345 1395 3 : 
3 1346 1394 2 END; : 
3; 1347 1395 2 ; 


23 
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74 Page 33 
14-Sep-1 FORR FOROPENDE .832;1 (19) 


139 ! 

9 

9 '¢ 
1738 } USEROPEN 
' If a USEROPEN prosedure ederess was specified then call the procedure 
' to do the SOPEN and SCONNECT; it will return an RMS status code as 
procedure value. yey do the SOPEN and SCONNECT ourselves. 
! 


et useropen flag, just as a debugging aid in case we get a dump with an SPR. 


IF .OPEN_ADR COPENSK_USEROPEN] NEQA 0 
THEN 


NOVUESWN “OO ODNAUES WO” 
—— 


3 1 

3 3 

3 1 

3 7 

| 

i 13 

3 1 1208 

a re 

3 3 1405 

3 1 1406 

3 1 1407 

3 1 1406 

: 1 1409 BEGIN 

3 1 1410 

3 1 1411 LOCAL ; 

3 i alg LOG_UNIT; ! Logical unit number 
3 1 1414 LOG_UNIT = .CCB CLUBSW_LUN]; ! Get the unit number 
We | 1415 CCB CLUBSV_USEROPEN) = 1; ' so we know the user opened the file! 
: 1369 1416 OPEN_STATUS = (.OPEN_ADR COPENSK_USEROPEN]) (FAB (0,0,0,0), 

; 1370 1417 -CCB, LOG_UNIT); 

3: 1371 1418 E 

3 1376 1419 . ELSE 

; 137 1420 BEGIN ' not USEROPEN 

: 1374 16s) 

; 1375 14 ; ‘+ 

: 1376 142 ! If old file is explicitly wanted, do an SOPEN. Otherwise 

3; 1377 1424 ' (NEW, SCRATCH, UNKNOWN, default = NEW) do a $CREATE. 

: 1378 1425 ' UNKNOWN has set RMS FABSV_CIF to do an OPEN if file 

3; 1379 1426 3 ' exists rather than a SCREATE. If file serene? existed 

; 1380 1427 3 ! on S$SCREATE (TYPE="UNKNOWN'), set LUBSV_OLD_FILE 3 

; 1381 1428 3 ! as flag that file already existed for error checking below. 
; 13ee 1o63 ; '- 

; 138 1430 

3; 1384 1431 4 OPEN_STATUS = ( 

; 1385 1O36 4 TF .CCB CLUBSV_OLD_FILE) 

3; 1386 1433 4 

: 1387 1434 5§ SOPEN (FAB = FAB (0,0,0,0)) 

; 1388 1435 4 ELS 3 

; 13589 1436 ; SCREATE (FAB = FAB (0,0,0,0))'; 

: E44 1437 

: 1391 1438 '¢ : : 
3 138 re If no error in open/create, do SCONNECT (pointer to FAB already set in RAB). 
3 1392 1441 

3; 1395 1oe6 IF .OPEN_STATUS THEN OPEN_STATUS = S$CONNECT (RAB = .CCB); 

: 1398 144 

; 1397 1444 END; 

; 1298 1445 

: 1399 1446 2 !<BLF/PAGE> 
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1-09 12-8081 38¢ 99:35: 6 FORRTL. RCIFOROPENDE .B 2;1 . (203 

401 4467 : 

ret 4 

4 4 + 

rh 5 Zero the XAB pointer in the FAB so we don't accidentally use it later. 

: : 

4 ; FAB CFABSL_XAB) = 0; 

oo 

14 

4 5 ! TYPE = ‘UNKNOWN’ has set RMS FABSV_CIF to do an open if file exitsts 

4 5 ! rather than a create. If file already existed on SCREATE (TYPE="UNKNOWN') 

2 2 set LUBSV_OLD_FILE as flag that file already existed for error checking below. 

4 6 

2 2 IF .FAB CFABSV_CIF] AND .FAB CFABSL_STS] NEQU RMS$_CREATED THEN CCB CLUBS$V_OLD_FILE] = 1; 


S 
: 1 
3 1 
s 1 
3: 1 
3 1 
3 1 
3 1 
3 1 
3: 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
: 1 
3; 1 
3 1 
: 1 
3 1 
3 1 
s 5 
3: 1 
3 1 
. > 
3 1 
3 1 
3 1 
3; 1 
3 1 
: 1 
: 1 
3: 1 
3; 1 
3 1 
: 1 
3 1 
3 1 
: 1 
3 1 
3: 1 
3 1 
2 1 
: 1 
3 1 


+ 
: If CALL ASSIGN allocated space for the filename, deallocate it. 


IF TESTBITSC (CCB CLUBSV_VIRT_RSNJ) 
FORSSFREE_VM (.CCB CLUBSB_RSL], .CCB [LUBSA_RSNJ); 


'¢ 

! If we have an expanded name string (or even better, a resultant name string), 
! point the LUB to it instead of the user supplied name. This will be 

the file name used for error messages from now on. 


ONO MEW —"ODOONOUES WN -O0@ 


IF _.NAM CNAMS$B_RSL] NEQ 0 
THEN 


GIN 
CLUBSA_RSN] = .NAM CNAMSL_RSA]; 
CLUBSB-RSLJ = .NAM CNAMSB-RSLJ; 


IF .NAM CNAM$B_ESL] NEQ 0 
THEN 


BEGIN 
CCB CLUBSA_RSN) 
Ene LUBS$B_RSLJ 


.NAM CNAMSL_ESA); 
-NAM CNAMS$B~ESLJ; 
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1 + (IF NOT .CCB CLUBSV_FIXED] THEN 4 ELSE 0) 
§ FORSK_INCRECLEN ! INCONSISTENT RECORD LENGTH 
5 a FORSK_OPEFAL =! OPEN FAILURE 

; FORSK_OPEFAI 
5 


oo 
oo 


ELS 


TUSSI 
S 


WN “OC OONOUFEWN—O 


p,FORSKOPEFAL 


COTHERWISE): 
FORSK_OPEFAI; 


6 
68 TES)); 
68 ' <BLF /PAGE> 
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1 -74 Page 3 
6 FORRTL. FOROPENDE .B852; 1 (22). 


ABR 1B 3 

3 3 5 1571 ‘+ 

: 1 : 1 I ! If the file we just opened was an existing file, perform a couple of 
3 1 157 ' consistency checks. 

3 1 1574 t= 

: 1531 1575 

* ; 1 6 IF .CCB CLUBSV_OLD_FILEJ 

3 1 137 THE 

. | 1578 BEGIN 

; 1535 1579 

5 1 1580 '¢ 

3 7 1581 ! Organization check: 

; 1538 15 ; ! If user program did not speci ty organization with this OPEN, 

; 1539 158 ! use the attributes from the file. If the user program did specify, 
; 1540 1584 ! check that it agrees with the file. 

3; 1561 1585 t= 

; 1266 1586 

: 154 1587 IF .OPEN_ADR COPENSK_ORGANIZA] NEQ 0 

3 15446 1588 3 THEN 

: 1545 1589 4 BEGIN 

3; 1546 1590 4 

: 1547 1591 4 LOCAL 

3; 1548 1336 4 3 

3; 1549 1593 4 

8 1330 \g0e 2 T= conse -OPEN_ADR COPENSK_ORGANIZA] FROM OPENSK_ORG_SEQ TO OPENSK_ORG_IDX OF 
3 1206 1596 5 COPENSK_ORG_SEQ]) : FABSC_SEQ; 

: 155 1597 § OPENSK_ORG_REL] : FABSC_REL: 

3; 1554 1598 5 OPENSK_ORG_IDX] : FABSC_IDX; 

3; 1555 1599 5§ LOUTRANGE) ? 

3; 1556 1600 6 BEGIN 

3; 1557 1601 6 SFORSSSIGNAL_STO (FORSK_INVARGFOR); 

; 1558 1606 5 ; 

3; 1559 1603 4 TES); 

; 1560 1604 4 

3; 1561 1605 4 IF .T NEQ .FAB CFABSB_ORG] THEN SFORSSSIGNAL_STO (FORSK_INCFILORG); 
3 1266 1606 4 

3 156 1607 3 END; 

3: 1564 1608 

3; 1565 1609 '¢ y 

3; 1566 1610 ' If ACCESS="KEYED' was specified and the file is not indexed, 

: 1567 1611 ! signal an error. 

<1 ey 

; 1570 1614 4 IF (.CCB CLUBSV_KEYED] AND .FAB CFABSB_ORG] NEQ FABSC_IDX) OR (.CCB CLUBSV_DIRECT] AND .FAB C 
g 132) 191? 4 z FAB$B_ORG) EQL FABSC_IDX) 

3 1238 1619 SFORSSSIGNAL_STO (FORSK_INCFILORG); 

3: 1574 1618 

3; 1575 1619 '¢ . : 

: 1276 19 If the file does not have sequential organization, then set LUB bit. 

: 157 16 

; 1378 YS IF (.FAB CFABSB_ORG] NEQ FABSC_SEQ) THEN CCB CLUBSV_NOTSEQORG) = 1; 
: 1581 1625 3 !<BLF/PAGE> 
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>; 1583 16 $ : 
3 3 16 
; 1585 1058 + 
3s 7 16 ' Record type check: 
3 1 16350 ! If user-program did not nege thee recoré=type in this OPEN, 
3; 35 1631 ! use the file attributes. If user-program did specify 
; 158 16 ¢ ! this OPEN, check that it agrees with the file. 
1891 1634 “ 
E 1236 1635 CASE .OPEN_ADR COPENSK_RECORDTY] FROM 0 10 OPENSK_REC_STMLF OF 
; 159 1636 SET 
; 1298 1637 
; 1595 1636 C0] : ! User did not specify 
; 1596 1639 4 BEGIN ; 
; 1597 1640 4 CCB CLUBSV_FIXED] = 0; ! Clear previously set bits 
; 1598 1641 4 CCB CLUBSV_SEGMENTED] = 0; 
; 1599 be 4 
; 1600 1645 4 If .FAB CFABSB_RFM) EQL FABSC_FIX 
; 1601 1644 4 TH é 
: 160 1645 4 CCB CLUBSV_FIXED] = 1 ! Fixed 
; 160 1646 4 ELS 
: 1604 1647 5 ! Variable 
; Me 178 : IF .CCB CLUBSV_DIRECT] AND NOT .CCB CLUBSV_NOTSEQORG) 
; 1607 1650 5 SFORSSSIGNAL_STO (FORSK_INCRECTYP); 
; 1608 1651 5 IF NOT .CCB CLUssy NOTSEQORG) AND .CCB_CLUBSV_UNFORMAT] AND 
: 1609 1936 g NOT .CCB CLUBSV_DIRECT] AND (.FAB CFABSB_RFM) EQL FABSC_VAR) 
: 1610 165 THEN 
3; 1611 1654 5 CCB CLUBSV_SEGMENTED) = 1; 
: Hb at 1655 4 END; 
3; 161 1656 END; 
3: 1614 1657 
; 1212 1638 COPENSK_REC_FIX] : 
: 344 1969 IF .FAB CFABSB_RFM) NEQU FABSC_FIX THEN SFORSSSIGNAL_STO (FORSK_INCRECTYP); 
; Hy a 1006 COPENSK_REC_VAR] : 
3 1631 \eee IF .FAB CFABSB_RFM) NEQU FABSC_VAR AND .FAB CFABSB_RFM) NEQU FABSC_VFC 
3 1858 1666 SFORSSSIGNAL_STO (FORSK_INCRECTYP); 
3 lose 1667 
; + 5 1008 COPENSK_REC_SEGM) : 
: 1637 1870 IF (.FAB CFABSB_RFM) NEQU FABSC_VAR) OR .CCB CLUBSV_NOTSEQORG) 
: 1698 1976 SFORSSSIGNAL_STO (FORSK_INCRECTYP); 
; 1631 1674 COPENSK_REC_STM) : 
; 1036 1675 
3 1oe7 1976 IF .FAB CFABSB_RFM) NEQU FABSC_STM 
3: 1635 1678 SFORSSSIGNAL_STO (FORSK_INCRECTYP); 
: 1636 1679 
: 163 1680 COPENSK_REC_STMCR] : 
; 1638 1681 
3; 1639 1682 IF .FAB CFABSB_RFM) NEQU FABSC_STMCR 


a oe 


11 
EN_DEFLT FORTRAN default open 18-50-1984 99: 32:00 AX-11 BLi 


1 BL $4506 V4.0-7 
FORRTL.SRC 


4 Page 39 
FOROPENDE B32; 1 9 08) 


38 
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5 1en0 1683 THEN 

s 196) 19 7 SFORSSSIGNAL_STO (FORSK_INCRECTYP); 
3 1648 19 COPENSK_REC_STMLF] : 

; 1645 16 8 IF .FAB CFABSB_RFM] NEQU FABSC_STMLF 

s | 16 THEN 

: 164 1690 SFORSSSIGNAL_STO (FORSK_INCRECTYP); 
: 1648 1691 

: 1649 1036 COUTRANGE) : 

; 1650 169 SFORSSSIGNAL_STO (FORSK_INVARGFOR); 

: 1651 1694 $3 

3 1926 1695 

: 165 1696 '+ 

3; 1654 1697 ' Set maximum record number from file. 

; 1655 1698 t= 

: 1656 1699 

3; 1657 1700 IF .CCB CLUBSL_REC_MAX] EQL 0 

3; 1658 1701 ; THEN 

3; 1659 1702 CCB CLUBSL_REC_MAX] = .FAB CFABSL_MRNI 
 1eeh hoe 3 = 

; cece 1702 : IF .FAB CFABSL_MRN] NEQ 0 THEN CCB CLUBSL_REC_MAX] = MIN (.CCB CLUBSL_REC_MAX], .FAB CFABSL_MRNJ 
> 16646 1707 3 : 

3; 1665 1708 3 !<BLF/PAGE> 


' 
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16-Sep-1984 00:37:00 AX=-11 Bliss-32 V4.0-74 
10288b-198¢ 19335398 FORRTL.SRCJFOROPENDE .B 2;1 


+ 
' Record size check: 

: f user specified a record size (with DEFINE FILE or RECORDSIZE 

‘ OPEN keyword, and MRS was reayires by RMS (fixed or relative), 

: or organization indexed and MRS is non-zero, then they must agree. 
— eeearee ae the OTS will use is then computed in a reasonable 

! nner. 

te 


+ 
! If not a disk or terminal, use the blocksize as the maximum recordsize 
(if not there already). 


IF (NOT .BLOCK CFAB CFABSL_DEV], DEVSV_RND;4, BYTE]) AND 
(NOT .BLOCK CFAB CFABSLIDEV], DEVSVTRM:4, BYTE) 


IF .FAB CFABSW_MRS] EQL 0 
FAB CFABSW_MRS] = .FAB CFABSW_BLS); 
IF NOT .V_DEFAULT_SIZE AND (.CCB CLUBSV_FIXED] 
OR .FAB CFABSB_ORG) EQL FABSC_REL) 
THEN 
IF .CCB CLUBSW_RBUF_SIZE] NEQU .FAB CFABSW_MRS] THEN SFORSSSIGNAL_STO (FORSK_INCRECLEN); 


IF (.CCB CLUBSV_FIXEDJ 
OR .FAB CFABSB_ORG) EQL FABSC_REL) 


ELS CCB CLUBSW_RBUF_SIZE] = .FAB CFABSW_MRS) 


oe 


_—— 


CCB CLUBSW_RBUF_SIZE] = MAXU (.CCB CLUBS$W_RBUF_SIZEJ, .FAB CFABSW_MRSJ, .XAB_BLOCK CXABSW_LRLJ) 


AS CFABSB_ORG] EQLU FABSC_IDX) AND (NOT .CCB CLUBSV_FIXED]) 
'¢ 
! For variable indexed files, determine if the MRS is zero. If it is, this is an ISAM file 
! created prior to FORTRAN v3 and should not be checked for buffer size agreement. 
: If no explicit RECL was specified, use the bucketsize to compute the buffersize. 


If .FAB CFABSW_MRS) EQLU 0 
THEN 


BEGIN 
if gV DEFAULT SIZE 
CCB CLUBS$W_RBUF_SIZE] = .FAB CFABSB_BKS) * 512; 
~ ELSE 
i This is a mew ISAM file. Check to be sure that the buffer size requested does 
! mot exceed the Max Recordsize specified when the file was created. Set the 
buffer size to the MRS to allow the records to grow. 


IF NOT .V_DEFAULT SIZE AND 
(.CCB CLUBSW_RBUF_SIZE] GTRU .FAB CFABSW_MRS)) 


) 


N 11 
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| 

: 1724 1766 3 THEN 
; \y 5 1700 4 SFORSSSIGNAL_STO (FORSK_INCRECLEN) 
; 4 ? 179? 1. CCB CLUBSW_RBUF _SIZE] = .FAB CFABSW_MRSJ; 
; 1729 1771 : Key definition check. If file is ORGANIZATION="INDEXED' and 
; 1730 \ite ! user specified a KEY definition, make sure it agrees with 
3; 1731 177 ! what the file actually has. Key sizes must match, and key 
3 7 ¢ 1774 ! datatypes must 
3 7 1775 ! match. If not, signal error FORS_INVKEYSPE. 
3: 1734 1776 : Make sure that we don't interfere with key XAB's that a 
: 1735 1777 ! USEROPEN might have defined. 
; 1736 1778 le 
3: 1737 1779 
; 1738 1780 ; IF .FAB CFABSB_ORG] EQL FABSC_IDX 
; 1739 1781 THEN 
: 1740 178s 4 BEGIN ! Indexed file 
3 1741 1783 4 
3 1086 1784 4 LOCAL ; 
3 174 1785 4 XAB_STATUS, ! Status while freeing XABs 
3 1744 1786 4 KEY_COUNT; ! Count of OPEN defined keys 
: 1745 1787 4 | 
3: 1746 1788 5 BEGIN 
3 1747 1789 5 
: 1748 1790 5 LOCAL | 
3: 1749 1791 5 KEY_DEFN : REF BLOCK (12, BYTE); 
: 1750 1236 5 
3 fe) 1m 2 KEY_DEFN = .OPEN_ADR COPENSK_KEY]; 
3 1788 1203 : IF .KEY_DEFN NEQ 0 THEN KEY_COUNT = .KEY_DEFN COPENSW_INFO] ELSE KEY_COUNT = 0; 
3; 1755 1797 4 END; 
> 1756 1798 4 | 
; 1757 1799 4 XAB_STATUS=SS$_NORMAL : 
: 1238 1800 4 KEY-XAB = .XAB-BLOCK CXABSL_NXT); | 
: 1760 1802 4 WHILE .KEY_XAB NEQU 0 AND .KEY_COUNT GTR 0 DO | 
: 1761 1803 5 BEGIN ! Go through XABs 
: 1766 1804 5 
3 176 1805 6 IF (.KEY_XAB CXAB$B_COD] EQL XABSC_KEY) 
3 1764 1806 5 THEN 
3: 1765 1807 6 BEGIN 
3: 1766 1808 6 
3: 1767 1809 7 IF (.KEY_XAB puneey Pos0} NEQ .KEY_XAB COPENSW_POSOJ) OR (.KEY_XAB CXAB$B_SIZ0] NEQ 
: 1768 1810 7 -KEY-XAB COPENS$B_S1Z0)) 
3; 1769 1811 6 
3 1700 sig $ XAB_STATUS = FORSK_INVKEYSPE; 
; 16 aie ° IF_.KEY_XAB COPENSB_KTYPE] NEQ .KEY_XAB CXAB$B_DTP] 
: 1774 1816 6 XAB_STATUS = FORSK_INVKEYSPE; 
3: 1775 1817 6 
3; 1776 1818 7 BEGIN 
2 ne cas 
3; 1779 1821 7 NEXT; ! Address of next XAB in Link 
; 1780 1822 7 


qoren Sere! FORTRAN default open 
; 1781 1823 7 
s 176 1824 7 
; 178 1825 7 
3 1784 1 $ 6 
: 1785 1 
s 1708 1828 
: 178 i 9 
3; 1788 1830 4 
: 1789 te 4 
; 1790 18 ¢ 4 
3; 1791 1835 4 
: 176 te 4 
3; 179 1835 4 
3 1794 1836 4 
3 1795 1837 4 
3: 1796 1838 4 
: 1797 1839 4 
; 1798 1840 4 
3; 1799 1841 4 
; 1800 13e6 4 
; 1801 184 
3 1802 1844 
: 1803 1845 END 
: 1804 1846 2 ELSE 
: 1805 1847 2 !<BLF/PAGE> 


NEXT = ,.KEY_XAB CXABS 
FORSSFREE_VM (OPENSK_XA 
KEY_XAB =".NEXT; 


END; 
KEY_COUNT = .KEY_COUNT = 3; 
END; 


1 
16-5 
14-5 
L.NXTJ; 

B_SIZE, .KEY_XAB); 


END; ! Go through XABs 
+ 
! If we had discovered any error while freeing the XAB's 
! we report it now. If we had reported it when we found it, 
! we would have been left with some XABs Laying around 
whose memory had not been deallocated. 
e ’ -XAB_STATUS 
SFORSSSIGNAL_STO (.XAB_STATUS); 
END; ! Indexed file 


! End of old file processing 


-1984 99: 35:90 VAX=11 Bliss-32 V4.0-74 
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14 
' Else (file was created) 
} Make sure V_APPEND is off so BACKSPACE will work. 


BEGIN 
CCB CLUBSV_APPEND] = 0; 
END 


'+ 
! If this is not a disk or terminal, and if RECL was not specified, 
then reduce the default recordsize to fit within the blocksize. 


IF .V_DEFAULT_SIZE 
THEN 


IF (NOT .BLOCK CFAB CFABSL_DEV], DEV$V_RND:4, BYTE]) AND 
(NOT .BLOCK CFAB_CFABSL~DEV], DEV$V~TRM;4, BYTEJ) AND 
peg AB CFABSW_BLS] NEG Oy 


BEGIN 
LOCAL 


NEW_RECL: WORD; 
NEW_RECC = .FAB CFABSW_BLSJ; 
IF 7CCB CLUBSV_SEGMENTED) 


THEN 
NEW_RECL = .NEW_RECL = 4; ' Compensate for length 
IF -NEW_RECL LSSU .CCB CLUBSW_RBUF_SIZEJ 


HEN 
——, CLUBSW_RBUF SIZE] = .NEW_RECL; 


14 

! If this is a process-permanent file, ignore the carriage-control 
! attributes RMS returned in the FAB and use the ones we set 
originally. RMS will properly convert our writes anyway. 


IF ,NAn CNAMSV_PPF) 
FAB CFABSB_RAT) = .ORIG_RAT; 
'¢ 


! Set up the List-directed output record size as RECL, if specified, 
else 81 (80 if mot FORTRAN carriage control). 


CCB CLUBSW_R_MARGIN] = (IF NOT .V_DEFAULT_SIZE THEN .CCB CLUBSW_RBUF_SIZE) ELSE 
(IF .FAB-CFABSV_FIN] THEN 81 ELSE 80)); 
'¢ 


i Set bits in the LUB to indicate the file's carriage control 
characteristics. This information is used by INQUIRE. 
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FORSSOPEN_DEFLT FORTRAN default open 16-Sep-1984 00:37: AX-11 Bliss-32 V4.0-74 Page 44. 
1-098 r 12286071382 995 35:98 FORRTL. RESFOROPENDE B92: . (25) 
7 1392 If .FAB CFABSV_F TN] 
>; 1865 19 $ THEN 
; 1 138 CCB CLUBSV_FTN] = 1; 
: 1 1908 IF .FAB LFABSV_CRI 
3: 1 1909 THEN 
; 1869 1910 CCB CLUB$V_CRJ = 1; 
: 1870 1911 IF .FAB LFABSV_PRNJ 
; 1871 1318 THEN 
: 1876 191 CCB CLUBSV_PRW] = 1; 
; 187 1914 
> 1874 1915 + 
: 1 ay ' Allocate record buffer dynan ices ty from LUBSW_RBUF_SIZE setting in bytes. 
: (1 6 191 ! Set LUBSA_RBUF_ADR to address of buffer allocated. 
; 187 1918 !- 
; 1878 1919 
; + 144 CCB CLUBSA_RBUF_ADR] = FORSSGET_VM (.CCB CLUB$W_RBUF_SIZE]); 
8 
; 1881 19 ¢ + 
; ist 19 ! Allocate dynamic storage for the file name so the name can be 
; 188 1924 2 ! used Later on for error diagnostics. Point the LUB to the new 
; 1884 1382 2 ! Location. (The size is already correct!) . 
> 1885 1926 : Indicate that the string name is now stored in virtual memory so 
; 1886 1927 ! it will be deallocated! 
>; 1887 1928 te 
: 1888 1368 
3; 1889 1930 BEGIN 
: 1890 1931 
: 1891 1338 LOCAL 
: 1996 1933 3 3 
; 189 1934 ; 
> 1894 1935 T = FORSSGET_VM (.CCB CLUBS$B_RSLJ); 
; 1895 1936 3 CHSMOVE (.CCB CLUBSB_RSLJ, .CCB CLUBSA_RSNJ, .T); 
; 1896 1937 3 CCB CLUBSA_RSN] = .T; 
; 1897 1938 3 NAM CNAMSL_RSA] = .T; 
>; 1898 1939 ; NAM ste Eat ® i 
3; 1899 1940 NAM CNAMSB_ESLJ = .CCB CLUBSB_RSLJ; 
; 1900 1941 3 CCB CLUBSV_VIRT_RSN) = 1; | 
: 1901 1306 § END; 
3 1308 194 
; 190 1944 § + jf : | 
3; 1904 1945 ! Store a code in the LUB indicating the type of organization. 
; 1905 1946 2 !- 
: 1906 1947 2 
: 1907 1948 SELECTONE (.FAB CFABSB_ORG]) OF 
; 1908 1949 SET 
; 1909 1950 
: 1910 1951 CF ABSC wit : 
3 + 4h 1936 CCB CLUBSB_ORGAN] = LUBS$K_ORG_SEQUE; 
: 191 1954 CFABSC_REL) : 
3 1914 1955 CCB CLUBSB_ORGAN) = LUBSK_ORG_RELAT; 
3 1915 1956 
3; 1916 1957 CFABSC_IDX) : 
Ba 8 on 
: 13D oct IF .CCB CLUBSV_SEGMENTED] THEN SFORSSSIGNAL_STO (FORSK_INCRECTYP); 


-_— 
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SSOPEN_DEFLT FORTRAN default open 1b-Sep-19 4 99:32:00 AX-11 Oi fege ze V4.0-74 Page 45 
9 14-Sep-1984 52:16 FORRTL.SRCJFOROPENDE .B852;1 (25) 
; 1921 196 CCB CLUBSB_ORGAN] = LUBS$K_ORG_INDEX; 
; 19 ¢ 196 END; 
; 19 1964 
: 1926 1965 COTHERWISE) : 
; 1925 1298 SFORSSSIGNAL_STO (FORSK_INCFILORG); 
: 1926 196 TES; 
3; 1927 1968 
: 1928 1969 + 
: 1929 1970 ! Set RAB fields that seldom change: UBF and USZ 
; 19350 1971 '- 
; 1931 1376 
: 19 2 197 CCB CRABSL_UBF) = .CCB [LUBSA_RBUF _ADRI; 
: 19 1974 CCB CRABSW-USZ] = .CCB CLUBSWIRBUF~SIZE); 
: 1934 1975 CCB CLUBSA_UBFJ = .CCB CLUBSA_RBUF_ADR); 
3; 1935 1976 
; 19 1977 '¢ 
3; 1937 1978 ! If the file is a sequential organization, sequential access 
> 1938 1979 i disk file which is not a PPF, enable RFA cacheing for BACKSPACE. 
: 1939 1980 !- 
; 1940 1981 
3; 1941 1956 IF NOT .CCB CLUBSV_NOTSEQORG) AND 
3 1306 198 NOT .CCB CLUBS$V_DIRECT] AND 
3 194 1984 NOT .CCB wes ea Le AND 
3 1944 1985 NOT .NAM CNAMSV~PPF) AND 
3 1945 1986 NOT .FAB CFAB$V~SQ0) 
3: 1946 1987 THE 
3 1947 1988 BEGIN 
3: 1948 1989 IND 
3 1949 1990 FAB_DEV = FAB CFABSL_DEV]: BLOCK (4, BYTE]; 
: 1950 1991 IF .FAB_DEV CDEV$V_RND] 7 Random-access device? 
: 1951 ime THEN 
3; 1952 199 BEGIN 
; 1953 1994 LOCAL 
3 1954 1995 RCE: REF RCE_R_RCE_STRUCT, 
> 1955 1996 OLD_RCE: REF ~RTE_R-RCE_STRUCT; 
1956 1997 
1957 1 + : 
1958 1999 ' Allocate space for the RFA cache entries. 
1959 2000 te 
1960 2 
1961 2 
1 2 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
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> 196 001 

; 196 00 RCE = FORSSGET_VM ( 

; 962 00 (RCE_K_CACRE_SIZE * RCE_S_RCE_STRUCT)); 

: 196 004 

; 1964 005 1+ ; : : 

3; 1965 006 ' Create a circularly Linked List of entries and zero the 
: 1966 2007 ' LOG_RECNO field of each entry. 

3 1967 43 !- 

: 1968 009 3 

3: 1969 2010 CCB LUSSA REA. CACHE BEG? = .RCE; ! First allocated byte 
3; 1970 011 CCB CLUBSA_RFA_CACHE PTR] = .RCE; !' Current entr 

; 1971 Ol OLD_RCE = <RCE~+ (RCE_K CACHE SIZE - 1) * RCE_S_RCE_STRUCT; 
3 ars 01 DECRU I FROM RCE_K_CACHE_SIZE~TO 1 DO 

3; 197 014 BEGIN 

3 1974 015 OLD_RCE CRCE_A NEXT] = .RCE; 

: 1975 aig RCE PRCE_A_PREV) = ,OLD_RCE; 

> 1976 01 RCE CRCE“L-LOG_RECNO) ="0; 

3; 1977 018 OLD_RCE = .RCE; 
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default open 


END; 


'¢ 


CCB 
CcB 


RETURN; 
END; 
54 55 50 PY 49 
55 50 54 55 4F 
44 2— 44 41 45 
3A 44 «(4145 ¢ 
54 50 45 43 4 
50 45 43 43 41 
44 ze 45 50 59 
3A 45 50 59 54 
2E 54 4E 49 52 
54 4E 49 52 50 
5E 
56 
50 
AB 66 
7E 
000000006 00 
56 
cD 70 = BB 


PIAA) 


MPPOPoPonronnroww 


F 12 
16-Sep-19 
14-Sep-19 


RCE = .RCE + RCE_S_RCE_STRUCT; 
END; 


LUBSK_LANG_FOR; 


59 53 00025 
59 53 0002F 
4F 46 QO03A 
4F 46 00045 
4F 46 Q004E 
4F 46 00058 
4F 46 00066 
4F 46 00071 
4F 46 QO07A 
4F 46 000 
07FC 00000 
cE 9 00 
AB o§ ; 00 
3C 13 QOO0A 
AB 00 0000C 
A6 9A 00010 
50 28 00014 
56 DD 00019 
Aé 9A 00018 
02 FB O001F 
AB D4 00026 
a A 00029 
19 13 0002D 
56 28 Q00¢F 
DD 000 


cce CLUBSV_RFA_CACHE_ENABLE) = 1; 


; Indicate that the file is now FORTRAN opened. 


LUB$B_LANGUAGE) = 
LUBSV_OPENEDJ = 1; 


‘4 
! Make sure that the FORTRAN exit handler will be called 
exits to purge the file's 1/0 buffers and close it, if 


Be 92:32: 


IF ( NOT .FORSSL_XIT_LOCK) THEN FORSSDECL_EXITH (); 


Return 


! End of 
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A~SYSS$OUTPUT= 
EXTRN 


“EXTRN 
* EXTRN 


-ENTRY 


00 
16 
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when the image 
necessary. 


from OPEN_PROC routine 


OPEN_PROC routine 


\SYSSINPUT:\ 


ORSTYPE:\ 
PRINT.DAT\ 


\FOR 
\FORSPRINT: \ 


P.AAB 
SYSSTRNLOG, SYSSPARSE 
SYSSOPEN, SYSSCREATE 


P.AAA 


SYSSCONNECT 


FORSSOPEN_PROC, Save R2,R3,R4,R5,R6,R7,R8,- 


9,R10 

~$82(SP), SP 

ge (cee) 

-24(CCB), HEAP_FAB 
1(HEAP_FAB), RO 

RO, (HEAP_FAB), 68(CCB? 
HEAP FAB 

1(HEAP FAB), =(SP) 

#2, FORSSFREE_VM 
-24(CCB) 

O(CCB), R6 

R6, @112(CCB), TEMP_FNS 
112(CCB) 
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! End of FORSSOPEN_DEFLT module 
LCL, REL, CON, 


Attributes 
RD , EXE, SHR, 


_FORSCODE + 0090 


PSECT SUMMARY 
3119 NOVEC,NOWRT, 


Routine Base: 


Bytes 


2975 bytes, 


; Routine Size: 
_F ORSCODE 


I 13 
FORSSOPEN_DEFLT FORTRAN default open 16-Sep-1984 :37:00 AX-11 Bliss-32 V4.0 Pa 2 
1-098 : Ve-Sep-1986 19:30:16 ERORRTL SRESFOROPENDE 682; 1 9° 255 
. Library Statistics 
: oceccece Symbols eoeeeecn Pages Processing 
; File Total idaded Percent Mapped Time 
: _$255SDUA28: SYSLIBISTARLET 132: 1 9776 127 1 581 00:01.1 
; ~$255$DUA28: CFORRTL.OBJ Byrn tes 711 283 39 52 00:00.6 
; _S$255SDUA28:CFORRTL.OBJIRTLLIB.L32;1 36 0 0 8 00:00.1 


; COMMAND QUALIFIERS 
BLISS/CHECK=(FIELD. INITIAL OPTIMIZE) /NOTRACE/LIS=L 15S :F OROPENDE /0BJ=08JS : F OROPENDE MSRC$:F OROPENDE /UPDATE=(ENH$: F OROPENDE 


: Size: 3012 code + 107 data bytes 
; Run Time: 1:26. 

; Elapsed Time: 03:27.2 

3; Lines/CPU Min: 1414 

F ee Ae ha 15974 

; Y Used: 1167 pages 

: — ation Complete 
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